home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / var.tcl < prev    next >
Encoding:
Text File  |  1997-09-02  |  9.9 KB  |  300 lines
  1. ##############################################################################
  2. # $Id: var.tcl,v 1.11 1997/09/03 05:43:35 stewart Exp $
  3. #
  4. # var.tcl - procedures for manipulating variables and the variable browser
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:delete_var {var} {
  26. global vTcl
  27.     set name [vTcl:var_root $var]
  28.     catch {
  29.         global $name
  30.         unset $var
  31.         if { $name != $var && "[array names $name]" == "" } {
  32.             unset $name
  33.         }
  34.     }
  35.     vTcl:list delete $name vTcl(vars)
  36. }
  37.  
  38. proc vTcl:find_new_vars {{a 0}} {
  39. global vTcl
  40.     update idletasks
  41.     return [vTcl:diff_list $vTcl(start,globals) [info globals]]
  42. }
  43.  
  44. proc vTcl:show_var {name} {
  45. global vTcl
  46.     if { $name != "" } {
  47.         set globname [vTcl:var_root $name]
  48.         global $globname
  49.         set value [subst $$name]
  50.         Window show .vTcl.var .vTcl.var $name $value
  51.     } else {
  52.         Window show .vTcl.var "" "" ""
  53.     }
  54. }
  55.  
  56. proc vTcl:update_var {} {
  57. global vTcl
  58.     set vTcl(var,name) [.vTcl.var.fra2.ent8 get]
  59.     set vTcl(var,value) [string trimright [.vTcl.var.fra3.tex10 get 0.0 end]]
  60.     set globname [vTcl:var_root $vTcl(var,name)]
  61.     global $globname
  62.     set $vTcl(var,name) $vTcl(var,value)
  63.     vTcl:list add $globname vTcl(vars)
  64.     grab release .vTcl.var
  65.     destroy .vTcl.var
  66.     vTcl:update_var_list
  67. }
  68.  
  69. proc vTcl:update_var_list {} {
  70. global vTcl
  71.     if { [winfo exists $vTcl(gui,varlist)] == 0 } { return }
  72.     $vTcl(gui,varlist).f2.list delete 0 end
  73.     foreach i $vTcl(vars) {
  74.         if {[vTcl:valid_varname $i] == 1} {
  75.             catch {global $i}
  76.             if {[array exists $i] == 1} {
  77.                 foreach j [array names $i] {
  78.                     $vTcl(gui,varlist).f2.list insert end "$i\($j\)"
  79.                 }
  80.             } else {
  81.                 $vTcl(gui,varlist).f2.list insert end $i
  82.             }
  83.         }
  84.     }
  85. }
  86.  
  87. proc vTcl:valid_varname {name} {
  88. global vTcl
  89.     if [regexp "^($vTcl(var,ignore))" $name] {
  90.         return 0
  91.     } else {
  92.         return 1
  93.     }
  94. }
  95.  
  96. proc vTcl:var_root {name} {
  97. set pos [string first "(" $name]
  98.     if {$pos > -1} {
  99.         return [string range $name 0 [expr $pos - 1]]
  100.     } else {
  101.         return $name
  102.     }
  103. }
  104.  
  105. proc vTclWindow.vTcl.var {args} {
  106.     global vTcl
  107.     set base [lindex $args 0]
  108.     set name [lindex $args 1]
  109.     set value [lindex $args 2]
  110.     if {[winfo exists .vTcl.var]} {
  111.         wm deiconify .vTcl.var; return
  112.     }
  113.     toplevel .vTcl.var -class vTcl
  114.     wm transient .vTcl.var .vTcl
  115.     wm focusmodel .vTcl.var passive
  116.     wm geometry .vTcl.var 338x136+276+319
  117.     wm maxsize .vTcl.var 1137 870
  118.     wm minsize .vTcl.var 1 1
  119.     wm overrideredirect .vTcl.var 0
  120.     wm resizable .vTcl.var 1 1
  121.     wm deiconify .vTcl.var
  122.     wm title .vTcl.var "Variable Editor"
  123.     bind .vTcl.var <Key-Escape> {vTcl:update_var}
  124.     frame .vTcl.var.fra2 \
  125.         -height 30 -width 30 
  126.     pack .vTcl.var.fra2 \
  127.         -in .vTcl.var -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  128.         -padx 3 -pady 3 -side top 
  129.     label .vTcl.var.fra2.lab7 \
  130.          \
  131.         -relief groove -text Variable 
  132.     pack .vTcl.var.fra2.lab7 \
  133.         -in .vTcl.var.fra2 -anchor center -expand 0 -fill none -ipadx 0 \
  134.         -ipady 0 -padx 2 -pady 0 -side left 
  135.     entry .vTcl.var.fra2.ent8 \
  136.         -cursor {}  \
  137.         -highlightthickness 0 -textvariable vTcl(var,name) 
  138.     pack .vTcl.var.fra2.ent8 \
  139.         -in .vTcl.var.fra2 -anchor center -expand 1 -fill both -ipadx 0 \
  140.         -ipady 0 -padx 2 -pady 2 -side left 
  141.     frame .vTcl.var.fra3 \
  142.         -borderwidth 2 -height 30 -relief groove -width 30 
  143.     pack .vTcl.var.fra3 \
  144.         -in .vTcl.var -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
  145.         -padx 3 -pady 3 -side top 
  146.     text .vTcl.var.fra3.tex10 \
  147.         -cursor {}  \
  148.         -height 1 -highlightthickness 0 -width 1 \
  149.         -yscrollcommand {.vTcl.var.fra3.scr12 set} 
  150.     pack .vTcl.var.fra3.tex10 \
  151.         -in .vTcl.var.fra3 -anchor center -expand 1 -fill both -ipadx 0 \
  152.         -ipady 0 -padx 2 -pady 2 -side left 
  153.     scrollbar .vTcl.var.fra3.scr12 \
  154.         -command {.vTcl.var.fra3.tex10 yview}
  155.     pack .vTcl.var.fra3.scr12 \
  156.         -in .vTcl.var.fra3 -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \
  157.         -padx 0 -pady 0 -side right 
  158.     frame .vTcl.var.fra4 \
  159.         -borderwidth 1 -height 30 -relief sunken -width 30 
  160.     pack .vTcl.var.fra4 \
  161.         -in .vTcl.var -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  162.         -padx 3 -pady 3 -side top 
  163.     button .vTcl.var.fra4.but5 \
  164.         -command {
  165.             vTcl:update_var
  166.         } \
  167.          -padx 9 \
  168.         -pady 3 -text OK -width 5 
  169.     pack .vTcl.var.fra4.but5 \
  170.         -in .vTcl.var.fra4 -anchor center -expand 1 -fill both -ipadx 0 \
  171.         -ipady 0 -padx 0 -pady 0 -side left 
  172.     button .vTcl.var.fra4.but6 \
  173.         -command {grab release .vTcl.var; destroy .vTcl.var} \
  174.          -padx 9 \
  175.         -pady 3 -text Cancel -width 5 
  176.     pack .vTcl.var.fra4.but6 \
  177.         -in .vTcl.var.fra4 -anchor center -expand 1 -fill both -ipadx 0 \
  178.         -ipady 0 -padx 0 -pady 0 -side left 
  179.  
  180.     set varname $base.fra2.ent8
  181.     set varvalue $base.fra3.tex10
  182.     set vTcl(var,name) $name
  183.     set vTcl(var,value) $value
  184.  
  185.     $varname delete 0 end
  186.     $varvalue delete 0.0 end
  187.     $varname insert end $name
  188.     $varvalue insert end $value
  189.  
  190.     if { [lindex $args 1] == "" } {
  191.         focus $varname
  192.     } else {
  193.         focus $varvalue
  194.     }
  195. }
  196.  
  197. proc vTcl:varlist:show {{on ""}} {
  198.     global vTcl
  199.     if {$on == "flip"} { set on [expr - $vTcl(pr,show_var)] }
  200.     if {$on == ""}     { set on $vTcl(pr,show_var) }
  201.     if {$on == 1} {
  202.         Window show $vTcl(gui,varlist)
  203.         vTcl:update_var_list
  204.     } else {
  205.         Window hide $vTcl(gui,varlist)
  206.     }
  207.     set vTcl(pr,show_var) $on
  208. }
  209.  
  210. proc vTclWindow.vTcl.varlist {args} {
  211.     global vTcl
  212.     set base .vTcl.varlist
  213.     if {[winfo exists .vTcl.varlist]} {
  214.         wm deiconify .vTcl.varlist; return
  215.     }
  216.     toplevel .vTcl.varlist -class vTcl
  217.     wm transient .vTcl.varlist .vTcl
  218.     wm focusmodel .vTcl.varlist passive
  219.     wm geometry .vTcl.varlist 200x200+714+382
  220.     wm maxsize .vTcl.varlist 1137 870
  221.     wm minsize .vTcl.varlist 200 200
  222.     wm overrideredirect .vTcl.varlist 0
  223.     wm resizable .vTcl.varlist 1 1
  224.     wm deiconify .vTcl.varlist
  225.     wm title .vTcl.varlist "Variables"
  226.     wm protocol $base WM_DELETE_WINDOW {vTcl:varlist:show 0}
  227.     bind .vTcl.varlist <Double-Button-1> {
  228.         set vTcl(x) [.vTcl.varlist.f2.list curselection]
  229.         if {$vTcl(x) != ""} {
  230.             vTcl:show_var [.vTcl.varlist.f2.list get $vTcl(x)]
  231.         }
  232.     }
  233.     frame .vTcl.varlist.frame7 \
  234.         -borderwidth 1 -height 30 -relief sunken -width 30 
  235.     pack .vTcl.varlist.frame7 \
  236.         -in .vTcl.varlist -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  237.         -padx 0 -pady 0 -side bottom 
  238.     button .vTcl.varlist.frame7.button8 \
  239.         -command {vTcl:show_var ""} \
  240.          -padx 9 \
  241.         -pady 3 -text Add -width 4 
  242.     pack .vTcl.varlist.frame7.button8 \
  243.         -in .vTcl.varlist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  244.         -ipady 0 -padx 0 -pady 0 -side left 
  245.     button .vTcl.varlist.frame7.button9 \
  246.         -command {
  247.             set vTcl(x) [.vTcl.varlist.f2.list curselection]
  248.             if {$vTcl(x) != ""} {
  249.                 vTcl:show_var [.vTcl.varlist.f2.list get $vTcl(x)]
  250.             }
  251.         } \
  252.          -padx 9 \
  253.         -pady 3 -text Edit -width 4 
  254.     pack .vTcl.varlist.frame7.button9 \
  255.         -in .vTcl.varlist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  256.         -ipady 0 -padx 0 -pady 0 -side left 
  257.     button .vTcl.varlist.frame7.button10 \
  258.         -command {
  259.             set vTcl(x) [.vTcl.varlist.f2.list curselection]
  260.             if {$vTcl(x) != ""} {
  261.                 vTcl:delete_var [.vTcl.varlist.f2.list get $vTcl(x)]
  262.                 .vTcl.varlist.f2.list delete $vTcl(x)
  263.             }
  264.         } \
  265.          -padx 9 \
  266.         -pady 3 -text Delete -width 4 
  267.     pack .vTcl.varlist.frame7.button10 \
  268.         -in .vTcl.varlist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  269.         -ipady 0 -padx 0 -pady 0 -side left 
  270.     button .vTcl.varlist.frame7.button11 \
  271.         -command { vTcl:varlist:show 0 } \
  272.         -padx 9 -pady 3 -text Done -width 4 
  273.     pack .vTcl.varlist.frame7.button11 \
  274.         -in .vTcl.varlist.frame7 -anchor center -expand 1 -fill x -ipadx 0 \
  275.         -ipady 0 -padx 0 -pady 0 -side left 
  276.     frame .vTcl.varlist.f2 \
  277.         -borderwidth 1 -height 30 -relief sunken -width 30 
  278.     pack .vTcl.varlist.f2 \
  279.         -in .vTcl.varlist -anchor center -expand 1 -fill both -ipadx 0 \
  280.         -ipady 0 -padx 0 -pady 0 -side top 
  281.     listbox .vTcl.varlist.f2.list \
  282.          \
  283.         -yscrollcommand {.vTcl.varlist.f2.sb4  set} 
  284.     pack .vTcl.varlist.f2.list \
  285.         -in .vTcl.varlist.f2 -anchor center -expand 1 -fill both -ipadx 0 \
  286.         -ipady 0 -padx 0 -pady 0 -side left 
  287.     scrollbar .vTcl.varlist.f2.sb4 \
  288.         -borderwidth 1 -command {.vTcl.varlist.f2.list yview}
  289.     pack .vTcl.varlist.f2.sb4 \
  290.         -in .vTcl.varlist.f2 -anchor center -expand 0 -fill y -ipadx 0 \
  291.         -ipady 0 -padx 0 -pady 0 -side right 
  292.  
  293.     wm withdraw $vTcl(gui,varlist)
  294.     vTcl:setup_vTcl:bind $vTcl(gui,varlist)
  295.     catch {wm geometry $vTcl(gui,varlist) $vTcl(geometry,$vTcl(gui,varlist))}
  296.     update idletasks
  297.     wm deiconify $vTcl(gui,varlist)
  298. }
  299.  
  300.